home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1996 / MacHack 1996.toast / Presentations / Presentations ’93 / Voice Toolkit / Voice Flag < prev    next >
Lisp/Scheme  |  1993-06-16  |  3KB  |  103 lines
  1.  
  2. (in-package "VOICE-TOOLKIT")
  3.  
  4. (defparameter *f-status* 0) 
  5.  
  6. (defclass flag (windoid) ())
  7.  
  8. (defmethod view-draw-contents ((self flag))
  9.   (call-next-method self)
  10.   (cond ((= *f-status* 0) (clean-flag))
  11.         ((= *f-status* 1) (question))
  12.         ((= *f-status* 2) (question-guess))
  13.         ((= *f-status* 3) (smile))
  14.         (t (frown))))
  15.  
  16. (defparameter *flag* 
  17.   (make-instance 'flag
  18.     :view-size #@(50 50)
  19.     :close-box-p nil
  20.     :window-show nil
  21.     :view-position (make-point 120 (- *screen-height* 70)))
  22.   "windoid status display")
  23.  
  24.  
  25. (defun hide-flag ()
  26.   (window-hide *flag*))
  27.  
  28. (defun show-flag ()
  29.   (window-show *flag*)
  30.   (view-draw-contents *flag*))
  31.  
  32.  
  33. (defun blank-flag ()
  34.   (setf *f-status* 0)
  35.   (clean-flag))
  36.  
  37. (defun clean-flag ()
  38.   (set-fore-color *flag* *white-color*)
  39.   (paint-rect *flag* #@(0 0) #@(50 50)))
  40.  
  41.  
  42. (defun question ()
  43.   "Draws blue question mark"
  44.   (if (not (= *f-status* 1))
  45.     (setf *f-status* 1))
  46.   (window-show *flag*)
  47.   (clean-flag)
  48.   (set-pen-size *flag* #@(4 4))
  49.   (set-fore-color *flag* *blue-color*)
  50.   (frame-arc *flag* 180 -270 #@(15 5) #@(35 25))
  51.   (move-to *flag* #@(23 21))
  52.   (line-to *flag* #@(23 28))
  53.   (move-to *flag* #@(23 35))
  54.   (line-to *flag* #@(23 37)))
  55.  
  56.  
  57. (defun question-guess ()
  58.   "Draws red question mark"
  59.   (if (not (= *f-status* 2))
  60.     (setf *f-status* 2))
  61.   (window-show *flag*)
  62.   (clean-flag)
  63.   (set-pen-size *flag* #@(4 4))
  64.   (set-fore-color *flag* *red-color*)
  65.   (frame-arc *flag* 180 -270 #@(15 7) #@(35 27))
  66.   (move-to *flag* #@(23 23))
  67.   (line-to *flag* #@(23 30))
  68.   (move-to *flag* #@(23 37))
  69.   (line-to *flag* #@(23 39))
  70.   (frame-oval *flag* #@(2 2) #@(48 48)))
  71.  
  72.  
  73. (defun smile ()
  74.   (if (not (= *f-status* 3))
  75.     (setf *f-status* 3))
  76.   (window-show *flag*)
  77.   (clean-flag)
  78.   (set-pen-size *flag* #@(2 2))
  79.   (set-fore-color *flag* *yellow-color*)
  80.   (paint-oval *flag* #@(5 5) #@(45 45))
  81.   (set-fore-color *flag* *black-color*)
  82.   (frame-oval *flag* #@(5 5) #@(45 45))
  83.   (paint-oval *flag* #@(16 19) #@(20 23))
  84.   (paint-oval *flag* #@(30 19) #@(34 23))
  85.   (frame-arc *flag* 90 180 #@(15 23) #@(35 38)))
  86.  
  87.  
  88. (defun frown ()
  89.   (if (not (= *f-status* 4))
  90.     (setf *f-status* 4))
  91.   (window-show *flag*)
  92.   (clean-flag)
  93.   (set-pen-size *flag* #@(2 2))
  94.   (set-fore-color *flag* *green-color*)
  95.   (paint-oval *flag* #@(5 5) #@(45 45))
  96.   (set-fore-color *flag* *black-color*)
  97.   (frame-oval *flag* #@(5 5) #@(45 45))
  98.   (paint-oval *flag* #@(16 19) #@(20 23))
  99.   (paint-oval *flag* #@(30 19) #@(34 23))
  100.   (frame-arc *flag* 90 -180 #@(15 28) #@(35 43)))
  101.  
  102.  
  103.